home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / timetrak / ttrakpxg.bas < prev   
Encoding:
BASIC Source File  |  1995-09-06  |  15.1 KB  |  344 lines
  1. '******* Declarations for Using the Paradox 3.5 Engine ******
  2. Declare Function PXWinInit Lib "Pxengwin.dll" (ByVal Application$, ByVal Mode%) As Integer
  3. Declare Function PXExit Lib "Pxengwin.dll" () As Integer
  4. '************ TABLE FUNCTIONS *****************
  5. Declare Function PXTblOpen Lib "Pxengwin.dll" (ByVal TblName$, TblHnd%, ByVal index%, ByVal change%) As Integer
  6. Declare Function PXTblClose Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  7. '************* RECORD FUNCTIONS *******************
  8. Declare Function PXRecAppend Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  9. Declare Function PXRecInsert Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  10. Declare Function PXRecUpdate Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  11. Declare Function PXRecDelete Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  12. Declare Function PXRecBufOpen Lib "Pxengwin.dll" (ByVal TblHnd%, RecHnd%) As Integer
  13. Declare Function PXRecBufClose Lib "Pxengwin.dll" (ByVal RecHnd%) As Integer
  14. Declare Function PXRecBufEmpty Lib "Pxengwin.dll" (ByVal RecHnd%) As Integer
  15. Declare Function PXRecGet Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  16. Declare Function PXRecFirst Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  17. Declare Function PXRecNext Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  18. Declare Function PXRecPrev Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  19. Declare Function PXRecNum Lib "Pxengwin.dll" (ByVal TblHnd%, RecNum%) As Integer
  20. Declare Function PXTblNRecs Lib "Pxengwin.dll" (ByVal TblHnd%, nRecs%) As Integer
  21. '**************** FIELD FUNCTIONS ****************
  22. Declare Function PXPutShort Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal sValue%) As Integer
  23. Declare Function PXPutDoub Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal dValue#) As Integer
  24. Declare Function PXPutLong Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal lValue&) As Integer
  25. Declare Function PXPutAlpha Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal aValue$) As Integer
  26. Declare Function PXPutBlank Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%) As Integer
  27. Declare Function PXPutDate Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal inDate As Any) As Integer
  28. Declare Function PXGetShort Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, sValue%) As Integer
  29. Declare Function PXGetDoub Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, dValue#) As Integer
  30. Declare Function PXGetLong Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, lValue&) As Integer
  31. Declare Function PXGetAlpha Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal bufSize%, ByVal aValue$) As Integer
  32. Declare Function PXFldBlank Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal Blank%) As Integer
  33. Declare Function PXGetDate Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, outDate As Any) As Integer
  34. Declare Function PXRecNFlds Lib "Pxengwin.dll" (ByVal TblHnd%, nFlds%) As Integer
  35. Declare Function PXFldHandle Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldName$, FldHnd%) As Integer
  36. Declare Function PXFldType Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldHnd%, ByVal BufSiz%, ByVal fldtype$) As Integer
  37. Declare Function PXFldName Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldHnd%, ByVal BufSiz%, ByVal FldName$) As Integer
  38. '*************** SEARCH FUNCTIONS *******************
  39. Declare Function PXSrchKey Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%, ByVal nFlds%, ByVal Mode%) As Integer
  40. Declare Function PXSrchFld Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%, ByVal FldNum%, ByVal Mode%) As Integer
  41. '***************** MISCELLANEOUS FUNCTIONS ****************
  42. Declare Function PXDateDecode Lib "Pxengwin.dll" (ByVal outDate As Any, mm%, dd%, yy%) As Integer
  43. Declare Function PXDateEncode Lib "Pxengwin.dll" (ByVal mm%, ByVal dd%, ByVal yy%, pDate&) As Integer
  44. '******************* NETWORK FUNCTIONS ******************
  45. Declare Function PXNetUserName Lib "Pxengwin.dll" (ByVal buffer%, UserName$) As Integer
  46. Declare Function PXNetFileLock Lib "Pxengwin.dll" (ByVal FileName$, ByVal lockType%) As Integer
  47. Declare Function PXNetFileUnlock Lib "Pxengwin.dll" (ByVal FileName$, ByVal lockType%) As Integer
  48. Declare Function PXNetTblLock Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal lockType%) As Integer
  49. Declare Function PXNetTblUnlock Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal lockType%) As Integer
  50. Declare Function PXNetRecLock Lib "Pxengwin.dll" (ByVal TblHnd%, LockHnd%) As Integer
  51. Declare Function PXNetRecLocked Lib "Pxengwin.dll" (ByVal TblHnd%, Locked%) As Integer
  52. Declare Function PXNetTblChanged Lib "Pxengwin.dll" (ByVal TblHnd%, Changed%) As Integer
  53. Declare Function PXNetTblRefresh Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  54.  
  55. Function Gen_Date (vDate As String)
  56.     pos1% = InStr(1, vDate, "/")
  57.     mm = Val(Mid$(vDate, 1, pos1% - 1))
  58.     pos2% = InStr(pos1% + 1, vDate, "/")
  59.     dd = Val(Mid$(vDate, pos1% + 1, pos2% - pos1% - 1))
  60.     temp$ = Mid$(vDate, pos2% + 1, 4)
  61.     If Len(temp$) = 4 Then
  62.         yy = Val(Mid$(temp$, 3, 2))
  63.     Else
  64.         yy = Val(temp$)
  65.     End If
  66.     If (mm < 1 Or mm > 12 Or dd < 1 Or yy < 1) Then
  67.         eflag% = 1
  68.     ElseIf mm = 2 And dd > 28 Then
  69.         eflag% = 1
  70.     ElseIf (mm = 4 Or 6 Or 9 Or 11) And dd > 30 Then
  71.         eflag% = 1
  72.     ElseIf dd > 31 Then
  73.         eflag% = 1
  74.     End If
  75.     If eflag% = 1 Then
  76.         Gen_Date = 1
  77.     Else
  78.         Gen_Date = 0
  79.         rc = PXDateEncode(mm, dd, yy, lValue)
  80.     End If
  81. End Function
  82.  
  83. Sub GetField (RecHnd%, FldHnd%, fldtype$)
  84.     returnFld = ""
  85.     aValue = ""
  86.     lValue = 0
  87.     dValue = 0
  88.     Select Case Mid$(fldtype$, 1, 1)
  89.         Case Is = "A"
  90.             rc = PXGetAlpha(RecHnd%, FldHnd%, 255, aValue)
  91.             PXError
  92.             returnFld = aValue
  93.         Case Is = "N"
  94.             rc = PXGetLong(RecHnd%, FldHnd%, lValue)
  95.             PXError
  96. '            If lValue < 0 Then
  97. '                lValue = 0
  98. '            End If
  99.             returnFld = Format$(lValue, "###0")
  100.         Case Is = "$"
  101.             rc = PXGetDoub(RecHnd%, FldHnd%, dValue)
  102.             PXError
  103. '            If dValue < 0 Then
  104. '                dValue = 0
  105. '            End If
  106.             returnFld = Format$(dValue, "###,##0.00")
  107.         Case Is = "D"
  108.             rc = PXGetDate(RecHnd%, FldHnd%, lValue)
  109.             PXError
  110.             rc = PXDateDecode(lValue, mm, dd, yy)
  111.             returnFld = LTrim$(Str$(mm)) + "/" + LTrim$(Str$(dd)) + "/" + LTrim$(Str$(yy))
  112.     End Select
  113.  
  114. End Sub
  115.  
  116. Sub PutField (RecHnd%, FldHnd%, fldtype$)
  117.     Select Case Mid$(fldtype$, 1, 1)
  118.         Case Is = "A"
  119.             rc = PXPutAlpha(RecHnd%, FldHnd%, aValue)
  120.             PXError
  121.         Case Is = "N"
  122.             rc = PXPutBlank(RecHnd%, FldHnd%)
  123.             PXError
  124.             rc = PXPutLong(RecHnd%, FldHnd%, lValue)
  125.             PXError
  126.         Case Is = "$"
  127.             rc = PXPutBlank(RecHnd%, FldHnd%)
  128.             PXError
  129. '           rc = PXPutLong(RecHnd%, FldHnd%, lValue)
  130.             rc = PXPutDoub(RecHnd%, FldHnd%, dValue)
  131.             PXError
  132.         Case Is = "D"
  133.             rc = PXPutDate(RecHnd%, FldHnd%, lValue)
  134.             PXError
  135.     End Select
  136.  
  137. End Sub
  138.  
  139. Sub PXError ()
  140.     Dim msgbuf As String
  141.     If rc = 0 Then
  142.         Exit Sub
  143.     End If
  144. '   msgbuff = Code + "=" + Str$(rc)
  145. '   msgbuff = PXErrMsg(rc)
  146.     Select Case rc
  147.         Case Is = NOT_PROGRAMMED
  148.             msgbuf = " Code Not Finished"
  149.         Case Is = PXERR_NOTINITERR
  150.             msgbuf = " Engine not initialized"
  151.         Case Is = PXERR_ALREADYINIT
  152.             msgbuf = "Engine already initialized"
  153.         Case Is = PXERR_NOTLOGGEDIN
  154.             msgbuf = " Could not log onto network"
  155.         Case Is = PXERR_NONETINIT
  156.             msgbuf = " Engine not initialized"
  157.         Case Is = PXERR_NETMULTIPLE
  158.             msgbuf = " multiple PARADOX.NET files"
  159.         Case Is = PXERR_CANTSHAREPDOXNET
  160.             msgbuf = " can't lock PARADOX.NET-is SHARE.EXE loaded?"
  161.         Case Is = PXERR_WINDOWSREALMODE
  162.             msgbuf = " can't run Engine in Windows real mode"
  163.         Case Is = PXERR_DRIVENOTREADY
  164.             msgbuf = " Drive not ready"
  165.         Case Is = PXERR_DISKWRITEPRO
  166.             msgbuf = " Disk is write protected"
  167.         Case Is = PXERR_GENERALFAILURE
  168.             msgbuf = " General hardware error"
  169.         Case Is = PXERR_DIRNOTFOUND
  170.             msgbuf = " Directory not found"
  171.         Case Is = PXERR_DIRBUSY
  172.             msgbuf = " Sharing violation-directory busy"
  173.         Case Is = PXERR_DIRLOCKED
  174.             msgbuf = " Sharing violation-directory locked"
  175.         Case Is = PXERR_DIRNOACCESS
  176.             msgbuf = " No access to directory"
  177.         Case Is = PXERR_DIRNOTPRIVATE
  178.             msgbuf = " Single user, but directory is shared"
  179.         Case Is = PXERR_FILEBUSY
  180.             msgbuf = " File is busy"
  181.         Case Is = PXERR_FILELOCKED
  182.             msgbuf = " File is locked"
  183.         Case Is = PXERR_FILENOTFOUND
  184.             msgbuf = " Could not find file"
  185.         Case Is = PXERR_TABLEBUSY
  186.             msgbuf = " Table is busy"
  187.         Case Is = PXERR_TABLELOCKED
  188.             msgbuf = " Table is locked"
  189.         Case Is = PXERR_TABLENOTFOUND
  190.             msgbuf = " Table was not found"
  191.         Case Is = PXERR_TABLEOPEN
  192.             msgbuf = " Unable to perform operation on open table"
  193.         Case Is = PXERR_TABLEINDEXED
  194.             msgbuf = " Table is indexed"
  195.         Case Is = PXERR_TABLENOTINDEXED
  196.             msgbuf = " Table is not indexed"
  197.         Case Is = PXERR_TABLEEMPTY
  198.             msgbuf = " Operation on empty table"
  199.         Case Is = PXERR_TABLEWRITEPRO
  200.             msgbuf = " Table is write protected"
  201.         Case Is = PXERR_TABLECORRUPTED
  202.             msgbuf = " Table is corrupted"
  203.         Case Is = PXERR_TABLEFULL
  204.             msgbuf = " Table is full"
  205.         Case Is = PXERR_TABLESQL
  206.             msgbuf = " Table is SQL replica"
  207.         Case Is = PXERR_INSUFRIGHTS
  208.             msgbuf = " Insufficient password rights"
  209.         Case Is = PXERR_XCORRUPTED
  210.             msgbuf = " Primary index is corrupted"
  211.         Case Is = PXERR_XOUTOFDATE
  212.             msgbuf = " Primary index is out of date"
  213.         Case Is = PXERR_XSORTVERSION
  214.             msgbuf = " Sort for index different from table"
  215.         Case Is = PXERR_SXCORRUPTED
  216.             msgbuf = " Secondary index is corrupted"
  217.         Case Is = PXERR_SXOUTOFDATE
  218.             msgbuf = " Secondary index is out of date"
  219.         Case Is = PXERR_SXNOTFOUND
  220.             msgbuf = " Secondary index was not found"
  221.         Case Is = PXERR_SXOPEN
  222.             msgbuf = " Secondary index is already open"
  223.         Case Is = PXERR_SXCANTUPDATE
  224.             msgbuf = " Can't update table open on non-maintained secondary"                                                                         'maintained secondary"
  225.         Case Is = PXERR_RECTOOBIG
  226.             msgbuf = " Record too big for index"
  227.         Case Is = PXERR_RECDELETED
  228.             msgbuf = " Another user deleted record"
  229.         Case Is = PXERR_RECLOCKED
  230.             msgbuf = " Record is locked"
  231.         Case Is = PXERR_RECNOTFOUND
  232.             msgbuf = " Record was not found"
  233.         Case Is = PXERR_KEYVIOL
  234.             msgbuf = " Key violation"
  235.         Case Is = PXERR_ENDOFTABLE
  236.             msgbuf = " End of table"
  237.         Case Is = PXERR_STARTOFTABLE
  238.             msgbuf = " Start of table"
  239.         Case Is = PXERR_TOOMANYCLIENTS
  240.             msgbuf = " Too many clients"
  241.         Case Is = PXERR_EXCEEDSCONFIGLIMITS
  242.             msgbuf = " Exceeds table conflicts"
  243.         Case Is = PXERR_CANTREMAPFILEHANDLE
  244.             msgbuf = " Cant remap file handle"
  245.         Case Is = PXERR_OUTOFMEM
  246.             msgbuf = " Not enough memory to complete operation"
  247.         Case Is = PXERR_OUTOFDISK
  248.             msgbuf = " Not enough disk space to complete operation"
  249.         Case Is = PXERR_OUTOFSTACK
  250.             msgbuf = " Not enough stack space to complete operation"
  251.         Case Is = PXERR_OUTOFSWAPBUF
  252.             msgbuf = " Not enough swap buffer space to complete operation"
  253.         Case Is = PXERR_OUTOFFILEHANDLES
  254.             msgbuf = " No more file handles available"
  255.         Case Is = PXERR_OUTOFTABLEHANDLES
  256.             msgbuf = " No more table handles"                                                                                    'available
  257.         Case Is = PXERR_OUTOFRECHANDLES
  258.             msgbuf = " No more record handles"                                                                               'available
  259.         Case Is = PXERR_OUTOFLOCKHANDLES
  260.             msgbuf = " Too many locks on table"
  261.         Case Is = PXERR_NOMORETMPNAMES
  262.             msgbuf = " No more temporary names available"
  263.         Case Is = PXERR_TOOMANYPASSW
  264.             msgbuf = " Too many passwords specified"
  265.         Case Is = PXERR_TYPEMISMATCH
  266.             msgbuf = " Data type mismatch"
  267.         Case Is = PXERR_OUTOFRANGE
  268.             msgbuf = " Argument out of range"
  269.         Case Is = PXERR_INVPARAMETER
  270.             msgbuf = " Invalid argument"
  271.         Case Is = PXERR_INVDATE
  272.             msgbuf = " Invalid date given"
  273.         Case Is = PXERR_INVFIELDHANDLE
  274.             msgbuf = " Invalid field handle"
  275.         Case Is = PXERR_INVRECHANDLE
  276.             msgbuf = " Invalid record handle"
  277.         Case Is = PXERR_INVTABLEHANDLE
  278.             msgbuf = " Invalid table handle"
  279.         Case Is = PXERR_INVLOCKHANDLE
  280.             msgbuf = " Invalid lock handle"
  281.         Case Is = PXERR_INVDIRNAME
  282.             msgbuf = " Invalid directory name"
  283.         Case Is = PXERR_INVFILENAME
  284.             msgbuf = " Invalid file name"
  285.         Case Is = PXERR_INVTABLENAME
  286.             msgbuf = " Invalid table name"
  287.         Case Is = PXERR_INVFIELDNAME
  288.             msgbuf = " Invalid field name"
  289.         Case Is = PXERR_INVLOCKCODE
  290.             msgbuf = " Invalid lock code"
  291.         Case Is = PXERR_INVUNLOCK
  292.             msgbuf = " Invalid unlock"
  293.         Case Is = PXERR_INVSORTORDER
  294.             msgbuf = " Invalid sort order table"
  295.         Case Is = PXERR_INVPASSW
  296.             msgbuf = " Invalid password"
  297.         Case Is = PXERR_INVNETTYPE
  298.             msgbuf = " Invalid net type (PXNetInit)"
  299.         Case Is = PXERR_BUFTOOSMALL
  300.             msgbuf = " Buffer too small for result"
  301.         Case Is = PXERR_STRUCTDIFFER
  302.             msgbuf = " Table structures are different"
  303.         Case Is = PXERR_INVENGINESTATE
  304.             msgbuf = " Previous fatal error"
  305.     End Select
  306.     response% = MsgBox(msgbuf, 17, "Paradox Error")
  307.     If response% <> MBOK Then
  308.        rc = PXExit()
  309.        End
  310.     End If
  311. End Sub
  312.  
  313. Sub PXInit (AppName$, Mode%)
  314.     'mode can be any of: PXSINGLECLIENT,PXEXCLUSIVE,PXSHARED
  315.     rc = PXWinInit(AppName$, Mode%)
  316.     PXError
  317. End Sub
  318.  
  319. Sub PXNext (TblHnd%, RecHnd%)
  320.     rc = PXRecNext(TblHnd%)
  321.     If rc = PXERR_ENDOFTABLE Then
  322.       Exit Sub
  323.     End If
  324.     rc = PXRecGet(TblHnd%, RecHnd%)
  325. End Sub
  326.  
  327. Sub PXOpen (TblName$, TblHnd%, RecHnd%)
  328.     rc = PXTblOpen(TblName$, TblHnd%, tIndex, True)
  329.     PXError
  330.     rc = PXRecBufOpen(TblHnd%, RecHnd%)
  331.     PXError
  332.     rc = PXRecBufEmpty(RecHnd%)
  333.     PXError
  334. End Sub
  335.  
  336. Sub PXPrev (TblHnd%, RecHnd%)
  337.     rc = PXRecPrev(TblHnd)
  338.     If rc = PXERR_STARTOFTABLE Then
  339.       Exit Sub
  340.     End If
  341.     rc = PXRecGet(TblHnd%, RecHnd%)
  342. End Sub
  343.  
  344.